Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE02/TPACK/TPACK.ZIP/USERINFO.PAS

Pascal/Delphi Source File | 1995-06-02 | 6.6 KB | 212 lines

{------------------------------------------------------------------------------}
{UNREGISTERED VERSION (6/1/95) PLEASE REDISTRIBUTE IN tPACK.ZIP!
 This revision does not contain everything, nor are the exciting
 DataSetReporter and ExtendedMenu[Item] components included.
 Use SWREG#5906 to receive these, icons and a help file for $130.
 You must register when using this code in a business application!
 You'll receive a license to use this code in up to 50 copies of
 any app you write. In turn you will get responsive e-mail
 tech support and enhancements till I run out of registrations
 or suggestions. Meanwhile.. enjoy the code. Bye! I'll make more.
 {(C)'1995 Michael/Ax-Systems, 71560,[e-mail]}
{------------------------------------------------------------------------------}

unit UserInfo;

interface

uses
  Classes, SysUtils, Wincrt, IniFiles, WinTypes, WinProcs, dbtables, Controls
, PasUtils
, Xtension
, Debug;

Type

  TComponentExtended = class(TComponent)
    cx: TComponentExtensions;
  public
    Constructor Create(aOwner:TComponent); Override;
    Destructor Destroy; Override;
    end;

  TUserInfoOptionTypes = (uifUpdateOnLoad,uifUpdateInDesign,uifUpdateOnGet);
  TUserInfoOptions     =  set of TUserInfoOptionTypes;
  TUserInfoStateTypes  = (uifUpdating,uifUpdated);
  TUserInfoState       =  set of TUserInfoStateTypes;

  TUserInfo = class(TComponentExtended)
  private
    fOptions: TUserInfoOptions;
    fState: TUserInfoState;
  protected
    function GetState:TUserInfoState;
    procedure SetState(Value:TUserInfoState);
    function GetUpdated: Boolean;
    procedure SetUpdated(Value:Boolean);
    function  CanUpdate:Boolean;
  public
    Constructor Create(aOwner:TComponent); Override;
    procedure Loaded; Override;
    procedure Update;
    function UpdateOK:Boolean; Virtual;
  published
    property Options: TUserInfoOptions read fOptions write fOptions; {what we can do}
    property State: TUserInfoState read fState write SetState stored False; {what we did}
    property Updated: Boolean read GetUpdated write SetUpdated stored false; {if we did}
    end;

  TDialogShell = class(TComponentExtended)
  protected
    procedure SetTest(Value:Boolean); virtual;
    function GetTest:Boolean; virtual;
  public
    constructor Create(aOwner:Tcomponent); Override;
    procedure Execute; virtual;
  published
    property Test: Boolean read GetTest write SetTest stored False;
    end;

implementation

uses Dialogs;

{-----------------------------------------------------------------------------------------}
{                                                                                         }
{-----------------------------------------------------------------------------------------}
{-----------------------------------------------------------------------------------------}
{ TComponentExtended OBJECT CREATION                                                      }
{-----------------------------------------------------------------------------------------}

Constructor TComponentExtended.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  cx:=TComponentExtensions.Create(Self);
  if (decCreate in DebugFlags) then
    if Owner=nil then
      DebugLog(Owner,'Create '+ClassName+' (nil)')
    else
      DebugLog(Owner,'Create '+ClassName+' ('+Owner.Name+':'+Owner.ClassName+')');
end;

Destructor TComponentExtended.Destroy;
begin
  if (decDestroy in DebugFlags) then
    DebugLog(Owner,'Destroy '+ClassName);
  cx.Free;
  inherited Destroy;
end;

{-----------------------------------------------------------------------------------------}
{ TDialogShell  BASE OBJECT  OBJECT CREATION                                              }
{-----------------------------------------------------------------------------------------}

Constructor TDialogShell.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
end;

procedure TDialogShell.Execute;
begin
end;

procedure TDialogShell.SetTest(Value:Boolean);
begin
  Execute;
end;

function TDialogShell.GetTest:Boolean;
begin
  Result:=True;
end;


{-----------------------------------------------------------------------------------------}
{ TUserInfo  BASE OBJECT  OBJECT CREATION                                                 }
{-----------------------------------------------------------------------------------------}

Constructor TUserInfo.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  Options:=[uifUpdateOnLoad,uifUpdateInDesign,uifUpdateOnGet];
end;

procedure TUserInfo.Loaded;
begin
  if (decLoaded in DebugFlags) then
    DebugLog(Owner,'Loaded '+ClassName);
  inherited Loaded;
  if not (csDesigning in ComponentState) then
    if uifUpdateOnLoad in Options then
      Update {actually 'update on load'}
    else
  else
    if uifUpdateInDesign in Options then
      Update; {might be ok to update in design mode as well}
end;

procedure TUserInfo.SetState(Value:TUserInfoState);
begin
{basically read-only, showing if prop editor because this proc is ref'd}
{made sensitive to -uifUpdated to allow cx.NilIfSet to unupdate a Userinfo Component}
  if Value=fState-[uifUpdated] then
    fState:=Value;
end;

function TUserInfo.GetState:TUserInfoState;
{purpose is to call the update proc when we try to turn the property on.}
begin
  if uifUpdateOnGet in Options then
    Update;
  Result:=fState;
end;

function TUserInfo.GetUpdated: Boolean;
begin
  if uifUpdateOnGet in Options then
    Update;
  Result:=uifUpdated in State; {might trigger autoupdate on read. that why we have the proc!}
end;

procedure TUserInfo.SetUpdated(Value:Boolean);
begin
  if not Value then
    State:= State - [uifUpdated]
  else
    if not (uifUpdated in State) and Value then
      Update;
end;

procedure TUserInfo.Update;
begin
  if ([uifUpdating,uifUpdated]*fState)<>[] then {sets intersect,e.g. state is either updating or updated}
    exit;
  fState:=fState+[uifUpdating]; {MUST access field, changing this property does not change the field!}
  if CanUpdate then
    fState:=fState+[uifUpdated];
  fState:=fState-[uifUpdating];
end;

function TUserInfo.CanUpdate:Boolean;
{purpose is to call the update proc when we try to turn the property on.}
begin

  if (decUpdate in DebugFlags) then
    with cx do begin
      DebugLog(Owner,'+Update '+Self.ClassName);
      Result:=UpdateOK;
      DebugLog(Owner,'-Update '+Self.ClassName+':= '+BoolString[Result]);
      end
  else
    Result:=UpdateOK {finally we see if it's ok to update now}
end;

function TUserInfo.UpdateOK:Boolean; {The 'Ancestor'}
begin
  Result:= True;
end;

end.